home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / sources.lha / sources / sys / vax_bignum.t < prev    next >
Text File  |  1988-02-05  |  3KB  |  78 lines
  1. (herald vax_bignum (env tsys))
  2.  
  3. ;;; Copyright (c) 1985 Yale University
  4. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  5. ;;; This material was developed by the T Project at the Yale University Computer 
  6. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  7. ;;; and to use it for any purpose is granted, subject to the following restric-
  8. ;;; tions and understandings.
  9. ;;; 1. Any copy made of this software must include this copyright notice in full.
  10. ;;; 2. Users of this software agree to make their best efforts (a) to return
  11. ;;;    to the T Project at Yale any improvements or extensions that they make,
  12. ;;;    so that these may be included in future releases; and (b) to inform
  13. ;;;    the T Project of noteworthy uses of this software.
  14. ;;; 3. All materials developed as a consequence of the use of this software
  15. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  16. ;;;    of acknowledging credit in academic research.
  17. ;;; 4. Yale has made no warrantee or representation that the operation of
  18. ;;;    this software will be error-free, and Yale is under no obligation to
  19. ;;;    provide any services, by way of maintenance, update, or otherwise.
  20. ;;; 5. In conjunction with products arising from the use of this material,
  21. ;;;    there shall be no use of the name of the Yale University nor of any
  22. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  23. ;;;    without prior written consent from Yale in each case.
  24. ;;;
  25.  
  26. (define (set-bignum-length! bignum length)
  27.   (lap ()  
  28.     (ashl ($ -6) (d@r A1 -2) S0)   ; length in bytes
  29.     (bicb2 ($ #b00000011) S0)
  30.     (subl2 A2 S0)                 ; size of bogus bytev including header
  31.     (subl2 ($ 4) S0)              ; bytev length
  32.     (ashl ($ 8) S0 S0)
  33.     (movb ($ header/bytev) S0)  ; bogus bytev header
  34.     (ashl ($ -2) A2 S1)           ; new length
  35.     (movl S0 (index (d@r A1 2) S1))
  36.     (ashl ($ 8) S1 S0)
  37.     (movb (d@r A1 -2) S0)
  38.     (movl S0 (d@r A1 -2))
  39.     (mnegl ($ 2) NARGS)
  40.     (movl (@r sp) tp)
  41.     (jmp (@r tp))))
  42.  
  43. (define-constant (bignum-positive? bignum)   ; if bit 7 of header is on
  44.   (fx= (mref-8-u bignum -4) 
  45.        (fixnum-add header/bignum 128)))
  46.  
  47. (define-constant bignum-negate!
  48.   (primop bignum-negate! ()
  49.     ((primop.side-effects? self) t)
  50.     ((primop.generate self node)                               
  51.      (let ((reg (->register 'pointer node (leaf-value ((call-arg 2) node)) '*)))
  52.        (emit vax/xorb2 (machine-num #b10000000) (reg-offset reg -2))))
  53.     ((primop.type self node)
  54.      '#[type (proc #f (proc #f top) bignum)])))
  55.  
  56. (define (%digit-divide x1 x0 y)   ; Divide x1x0 by y with x1 < (* 2 y)
  57.   (lap ()
  58.     (rotl ($ -2) a1 s1)          ; == Logical shift right by 2
  59.     (movl a2 s0)                 ; Dividend in S1,S0
  60.     (ashq ($ -2) s0 s0)          ; Remove dividend tag
  61.     (rotl ($ -2) a3 s2)          ; Divisor in S2 (without tag)
  62.  
  63.     (ediv s2 s0 a1 a2)           ; Boom
  64.  
  65.     (ashl ($ 2) a1 a1)           ; Fixnumize quotient
  66.     (ashl ($ 2) a2 a2)           ;   and remainder
  67.     (mnegl ($ 3) nargs)          ; Two values returned
  68.     (movl (@r sp) tp)
  69.     (jmp (@r tp))))
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.